SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00007 TEXT EDITING ROUTINES 1 05-28-9314:08ALL SWAG SUPPORT TEAM CENTER1.PAS IMPORT 5 {π>Anyways, does anyone here have a quick and easy Procedure orπ>Function For centering Text?π}ππProgram CenterIt_Demo;ππUsesπ Crt;ππ{ Display a String centered on the screen. }πProcedure DisplayCenter(st_Temp : String; by_Yaxis : Byte);πbeginπ GotoXY(((Succ(Lo(WindMax)) - Length(st_Temp)) div 2), by_Yaxis);π Writeln(st_Temp);πend; {DisplayCenter. }ππVarπ by_OldAttr : Byte;ππbeginπ ClrScr;π DisplayCenter('The Spirit of Elvis says... Hi!', 10);π ReadKey;πend.π 2 05-28-9314:08ALL SWAG SUPPORT TEAM CENTER2.PAS IMPORT 3 { Center Text }ππUses Crt;πVarπ s : String;π i : Integer;πbeginπ Write('String? ');π readln(s);π i := (succ(lo(windmax)) - length(s)) shr 1;π gotoXY(i,10);π Write(s);πend.π 3 05-28-9314:08ALL SWAG SUPPORT TEAM FORMAT1.PAS IMPORT 14 {π> - How can I get TP to make what ever the user enters in to CAPS or │π> NONCAPS? Example: │π> Enter Name -> ChRiS BrAtEnE │π> Your name is Chris Bratene? (Y/n)? │πππI just wrote a routine that does this on the fly, so to speak, Forπanother user, and I haven't erased it yet, so here it is (slightlyπmodified, so that it Forces lowerCase, too):π}ππUsesπ Crt;ππProcedure Backspace;πbeginπ Write(#8' '#8)πend;ππFunction LoCase(ch : Char) : Char;πbeginπ if ch in ['A'..'Z'] thenπ LoCase := Char(ord(ch)+32)π elseπ LoCase := ch;πend;ππProcedure Dibble(Var st : String);π{ Forces upperCase For first letter in each Word,π lowerCase For other letters. }πVarπ len : Byte Absolute st;π ch : Char;ππ Function ForceCap : Boolean;π beginπ ForceCap := (len = 0) or (st[len] = ' ');π end;ππbeginπ st := '';π Repeatπ ch := ReadKey;π if ForceCap thenπ ch := upCase(ch)π elseπ ch := LoCase(ch);π Case ch ofπ #8 : if len > 0 thenπ beginπ Backspace;π dec(len);π end;π #27 : While len > 0 doπ beginπ BackSpace;π dec(len);π end;π #0 : ch := ReadKey;ππ elseπ beginπ Write(ch);π st := st + ch;π end;ππ end;π Until ch in [#13,#27];ππ Writeln;ππend;πππVarπ st : String;ππbegin { test }π Writeln;π Write('Enter String: ');π Dibble(st);π Writeln(st);πend.π 4 05-28-9314:08ALL SWAG SUPPORT TEAM GHOSTED.PAS IMPORT 77 TR>Can anyone (please, it's important) , post here an example of a source codeπTR>that will show a text file , and let me scroll it (Up , Down ) ?πTR>Also I need an example of a simple editor.ππTry this for an example. Turbo Pascal 6.0+ source.πCompiles to a 7K text editor. Neat?ππ{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}π{$M $C00,0,0}πprogram ghostEd; {Ghost Editor v0.4 (C) 1993 Sean L. Palmer}πconstπ version='0.4';π maxF=$3FFF; {only handles small files!}π txtColor=$B;π vSeg:word=$B800;πvarπ nLines:byte;π halfPage:byte;π txt:array[0..maxF]of char;π crs,endF,pgBase,lnBase:integer;π x,y:word;π update:boolean;π theFile:file;π ticks:word absolute $40:$6C; {ticks happen 18.2 times/second}ππprocedure syncTick;var i:word;begin i:=ticks;repeat until i<>ticks;end;ππfunction readKey:char;assembler;asm mov ah,$07; int $21; end;ππfunction keyPressed:boolean;assembler;asm mov ah,$B; int $21; and al,$FE;πend; ππprocedure moveScrUp(s,d,n:word);assembler;asmπ mov cx,n;π push ds;π mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; shl si,1;π mov di,d; shl di,1;π cld; repz movsw; {attr too!}π pop ds; @X:π end;ππprocedure moveScrDn(s,d,n:word);assembler;asmπ mov cx,n;π push ds;π mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; add si,cx; shl si,1;π mov di,d; add di,cx; shl di,1;π std; repz movsw; {attr too!}π pop ds; @X:π end;ππprocedure moveScr(var s;d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π lds si,s;π cld;π@L: movsb; inc di; loop @L;π pop ds; @X:π end;ππprocedure fillScr(d,n:word;c:char);assembler;asmπ mov cx,n; jcxz @X;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π mov al,c; cld;π@L: stosb; inc di; loop @L;π@X:π end;ππprocedure fillAttr(d,n:word;c:byte);assembler;asmπ mov cx,n; jcxz @X;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π mov al,c; cld;π@L: inc di; stosb; loop @L;π@X:π end;ππprocedure cls;beginπ fillAttr(80,pred(nLines)*80,txtColor);π fillScr(80,pred(nLines)*80,' ');π end;ππprocedure scrollUp;beginπ moveScrUp(320,160,pred(nLines)*160);π fillScr(pred(nLines)*160,80,' ');π end;πprocedure scrollDn;beginπ moveScrDn(160,320,pred(nLines)*320);π fillScr(160,80,' ');π end;ππ{put cursor after preceding CR or at 0}πfunction scanCrUp(i:integer):integer;assembler;asmπ mov di,i; mov cx,di; add di,offset txtπ mov ax,ds; mov es,ax;π std; mov al,$D;π dec di;π repnz scasb;π jnz @S; inc di; @S:π inc di;π sub di,offset txt;π mov ax,di;π end;ππ{put cursor on next CR or endF}πfunction scanCrDn(i:integer):integer;assembler;asmπ mov di,i; mov cx,endF;π sub cx,di; inc cx; add di,offset txt;π mov ax,ds; mov es,ax;π cld; mov al,$D;π repnz scasb;π dec di;π sub di,offset txt;π mov ax,di;π end;ππprocedure findxy;beginπ lnBase:=scanCrUp(crs);x:=crs-lnBase;π y:=1;pgBase:=lnBase;π while(pgBase>0)and(y<halfPage) do beginπ pgBase:=scanCrUp(pred(pgBase)); inc(y);π end;π end;ππprocedure display;var i,j,k,oldY:integer;beginπ findXY;π if update then beginπ update:=false;π j:=pgBase;i:=1;π while (j<=endf) and (i<pred(nLines)) do beginπ k:=scanCrDn(j);π moveScr(txt[j],i*80,k-j);π fillScr(i*80+k-j,80-k+j,' ');π fillAttr(i*80,80,txtColor);π j:=succ(k); inc(i);π end;π if i<pred(nLines) then beginπ fillScr(i*80,80*pred(nLines-i),'X');π fillAttr(i*80,80*pred(nLines-i),1);π end;π endπ else beginπ>>> Continued to next messageππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)ππ>>> Continued from previous messageπ i:=scanCrDn(lnBase)-lnBase;π moveScr(txt[lnBase],y*80,i);π fillScr(y*80+i,80-i,' ');π end;π end;ππconst menuStr:string='Ghost Editor v'+version+'-(C) Sean Palmer 1993';πprocedure title;beginπ fillAttr(0,80,$70);fillScr(0,80,' ');π MoveScr(MenuStr[1],1,length(MenuStr));π end;ππprocedure error(s:string);beginπ fillattr(0,80,$CE);fillScr(0,80,' ');π moveScr(s[1],1,length(s));π write(^G);readkey;π title;π end;ππprocedure tooBigErr;begin error('File too big');end;ππprocedure insChar(c:char);forward;πprocedure delChar;forward;πprocedure backChar;forward;ππprocedure trimLine;var i,t,b:integer;beginπ i:=crs;π b:=scanCrDn(crs); t:=scanCrUp(crs);π crs:=b;π while txt[crs]=' ' do beginπ delchar;π if i>crs then dec(i);π if crs>0 then dec(crs);π end;π crs:=i;π end;ππprocedure checkWrap(c:integer);var i,t,b:integer;beginπ b:=scanCrDn(c); t:=scanCrUp(c);π i:=b;π if i-t>=79 then beginπ i:=t+79;π repeat dec(i); until (txt[i]=' ')or(i=t);π if i=t then backChar {just disallow lines that long with no spaces}π else beginπ txt[i]:=^M; {change sp into cr, to wrap}π update:=true;π if (b<endF)and(txt[b]=^M)and(txt[succ(b)]<>^M) then beginπ txt[b]:=' '; {change cr into sp, to append wrapped part to next line}π checkWrap(b); {recursively check next line since it got stuff added}π end;π end;π end;π end;ππprocedure changeLines;beginπ trimLine; update:=true; {signal to display to redraw}π end;ππprocedure insChar(c:char);beginπ if endf=maxF then begin tooBigErr;exit;end;π move(txt[crs],txt[succ(crs)],endf-crs);π txt[crs]:=c;inc(crs);inc(endf);π if c=^M then changeLines;π checkWrap(crs);π end;πprocedure delChar;beginπ if crs=endf then exit;π if txt[crs]=^M then changeLines;π move(txt[succ(crs)],txt[crs],endf-crs);π dec(endf);π checkWrap(crs);π end;ππprocedure addLF;var i:integer;beginπ for crs:=endF downto 1 do if txt[pred(crs)]=^M then beginπ insChar(^J); dec(crs);π end;π end;ππprocedure stripLF;var i:integer;beginπ for crs:=endF downto 0 do if txt[crs]=^J then delChar;π end;ππprocedure writeErr;begin error('Write Error');end;ππprocedure saveFile;beginπ addLF;π rewrite(theFile,1);π if ioresult<>0 then writeErrπ else beginπ blockwrite(theFile,txt,endf);π if ioresult<>0 then writeErr;π close(theFile);π end;π end;ππprocedure newFile;begin crs:=0;endF:=0;update:=true;end;ππprocedure readErr;begin error('Read Error');end;ππprocedure loadFile;var i,n:integer;beginπ reset(theFile,1);π if ioresult<>0 then newFileπ else beginπ n:=filesize(theFile);if n>maxF then begin tooBigErr;n:=maxF;end;π blockread(theFile,txt,n,i);if i<n then readErr;π close(theFile);π crs:=0;endf:=i;update:=true;π stripLF;π end;π end;ππprocedure signOff;var f:file;i,n:integer;beginπ assign(f,'signoff.txt');π reset(f,1);π if ioresult<>0 then error('No SIGNOFF.TXT defined') {no macro defined}π else beginπ n:=filesize(f);π blockread(f,txt[endF],n,i);if i<n then readErr;π close(f);π inc(endf,i);update:=true;π i:=crs; stripLF; crs:=i; {stripLF messes with crs}π end;π end;ππprocedure goLf;beginπ if crs>0 then dec(crs);π if txt[crs]=^M then changeLines;π end;πprocedure goRt;beginπ if txt[crs]=^M then changeLines;π if crs<endf then inc(crs);π end;πprocedure goCtrlLf;var c:char;beginπ repeat goLf;c:=txt[crs];until (c<=' ')or(crs=0);π end;πprocedure goCtrlRt;var c:char;beginπ repeat goRt;c:=txt[crs];until (c<=' ')or(crs>=endF);π end;πprocedure goUp;var i:integer;beginπ if lnBase>0 then beginπ changeLines;π lnBase:=scanCrUp(pred(lnBase));crs:=lnBase;π i:=scanCrDn(crs)-crs;π>>> Continued to next messageππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π π π >>> Continued from previous messageπ if i>=x then inc(crs,x) else inc(crs,i);π end;π end;πprocedure goDn;var i:integer;beginπ changeLines;π crs:=scanCrDn(crs);if crs>=endF then exit;π inc(crs);lnBase:=crs;π i:=scanCrDn(crs)-crs;π if i>=x then inc(crs,x) else inc(crs,i);π end;πprocedure goPgUp;var i:byte;begin for i:=halfPage downto 0 do goUp; end;πprocedure goPgDn;var i:byte;begin for i:=halfPage downto 0 do goDn; end;πprocedure goHome;begin crs:=scanCrUp(crs); end;πprocedure goEnd;begin crs:=scanCrDn(crs); end;ππprocedure backChar;beginπ if (crs>0) then begin goLf; delChar; end;π end;ππprocedure deleteLine;var i:integer;beginπ i:=scanCrDn(crs);crs:=scanCrUp(crs);π if i<endF then begin move(txt[succ(i)],txt[crs],endf-i); dec(endF);end;π dec(endf,i-crs); changeLines;π end;ππprocedure flipCursor;var j,k,l:word;beginπ j:=succ((y*80+x)shl 1);π l:=mem[vSeg:j]; {save attr under cursor}π mem[vSeg:j]:=$7B; if not keypressed then syncTick;π mem[vSeg:j]:=l; if not keypressed then syncTick;π end;ππprocedure edit;var c:char;beginπ repeatπ display;π repeat flipcursor;until keypressed;π c:=readkey;π if c=#0 then case readkey ofπ #59:signOff;π #75:goLf;π #77:goRt;π #115:goCtrlLf;π #116:goCtrlRt;π #72:goUp;π #80:goDn;π #83:delChar;π #73:goPgUp;π #81:goPgDn;π #71:goHome;π #79:goEnd;π endπ else case c ofπ ^[:saveFile;π ^H:backChar;π ^C:{abortFile};π ^Y:deleteLine;π else insChar(c);π end;π until (c=^[)or(c=^C);π end;ππfunction getRows:byte;assembler;asmπ mov ax,$1130; xor dx,dx; int $10;π or dx,dx; jnz @S; mov dx,24; @S: {cga/mda don't have this fn}π inc dx; mov al,dl;π end;ππvar oldMode:byte;πbeginπ asm mov ah,$F; int $10; mov oldMode,al; end; {save old Gr mode}π if oldMode=7 then vSeg:=$B000; {check for Mono}π nLines:=getRows;π halfPage:=pred(nLines shr 1);π cls; title;π if paramCount=0 then error('Need filename as parameter')π else beginπ asm mov bh,0; mov dl,0; mov dh,nLines; mov ah,2; int $10; end; {put cursorπof assign(theFile,paramStr(1));π loadFile;π edit;π end;π end.ππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π π π 5 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP1.PAS IMPORT 12 {This was a Programming contest Program- BTW, this is to VanπSlingerhead, not to Mike...π}πProgram Wordwrap; πUses Crt,Printer; πConstπ max = 10; πVarπ ch : Char;π arr : Array[1..800] of Char;π small,π s : String;π w,π len,π counter : Integer; πbeginπ w := 1;π Writeln; Writeln;π Repeatπ arr[w] := ReadKey;π inc(w);π if arr[w-1] = #8 thenπ beginπ Write(#8' '#8);π if w > 2 thenπ dec(w,2)π elseπ w:= 1;π end { if }π elseπ Write(arr[w-1]);π Until arr[w-1] = #13;π arr[w-1] := ' ';ππ dec(w);π Writeln; Writeln;π For counter := 1 to w doπ Write(arr[counter]);ππ small := '';π len := 0;π Writeln(lst);π Writeln(lst,'123456789012345678901234567890123456789012345');π Writeln(lst,' ^ ^ ^ ^ ^');π For counter := 1 to w doπ beginπ if arr[counter] <> ' ' thenπ beginπ small := small + arr[counter];π inc(len);π endπ elseπ if len <= 45 thenπ beginπ Write(lst,small,' ');π small := '';π inc(len);π endπ elseπ beginπ Writeln(lst);π Write(lst,small,' ');π len := length(small)+1;π small := '';π end; { else }π end; πend.ππ 6 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP2.PAS IMPORT 18 {π> P.S. A pre-made Unit to do a Word-wrap Function might also be nice.π}ππUnit WordWrap;ππInterfaceππUsesπ Crt;ππTypeπ Strn80 = String[80];ππConstπ MaxWordLineLength : Byte = 80;ππVarπ WordLine : Strn80;π Index1 : Byte;π Index2 : Byte;ππProcedure ResetWrapStrn;πProcedure WrapStrn (InputStrn: Strn80);ππImplementationππProcedure ResetWrapStrn;πbeginπ Index1 := 0;π Index2 := 0;π Wordline := '';πend;ππProcedure WrapStrn (InputStrn: Strn80);πVarπ Count : Byte;π InputChar : Char;πbeginπ For Count := 1 to Length (InputStrn) doπ beginπ InputChar := InputStrn[Count];π Case InputChar OFπ ^H: {Write destructive backspace & remove Char from WordLine}π beginπ Write(^H,' ',^H);π DELETE(WordLine,(LENGTH(WordLine) - 1),1)π end;π #0: {user pressed a Function key, so dismiss it}π beginπ InputChar := ReadKey; {Function keys send two-Char scan code!}π InputChar := ' 'π end;π #13: { it is an enter key.. reset everything and start on a new line}π beginπ Writeln;π Index1 := 0; Index2 := 0; Wordline := '';π end;π else {InputChar contains a valid Char, so deal With it}π beginπ Write(InputChar);π WordLine := (WordLine + InputChar);π if (LENGTH(WordLine) >= (MaxWordLineLength - 1)) thenπ {we have to do a Word-wrap}π beginπ Index1 := (MaxWordLineLength - 1);π While ((WordLine[Index1] <> ' ') and (WordLine[Index1] <> '-')π and (Index1 <> 0)) DOπ Index1 := (Index1 - 1);π if (Index1 = 0) then {whoah, no space was found to split line!}π Index1 := (MaxWordLineLength - 1); {forces split}π DELETE(WordLine,1,Index1);π For Index2 := 1 to LENGTH(WordLine) DOπ Write(^H,' ',^H);π Writeln;π Write(WordLine)π endπ endπ end; {CASE InputChar}π end;πend;ππbegin {WordWrap}π{Initialize the Program.}πWordLine := '';πIndex1 := 0;πIndex2 := 0;πend.π 7 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP3.PAS IMPORT 28 Varπ S : String;ππFunction Wrap(Var st: String; maxlen: Byte; justify: Boolean): String;π { returns a String of no more than maxlen Characters With the last }π { Character being the last space beFore maxlen. On return st now has }π { the remaining Characters left after the wrapping. }π Constπ space = #32;π Varπ len : Byte Absolute st;π x,π oldlen,π newlen : Byte;ππ Function JustifiedStr(s: String; max: Byte): String;ππ { Justifies String s left and right to length max. if there is more }π { than one trailing space, only the right most space is deleted. The}π { remaining spaces are considered "hard". #255 is used as the Char }π { used For padding purposes. This will enable easy removal in any }π { editor routine. }ππ Constπ softSpace = #255;π Varπ jstr : String;π len : Byte Absolute jstr;π beginπ jstr := s;π While (jstr[1] = space) and (len > 0) do { delete all leading spaces }π delete(jstr,1,1);π if jstr[len] = space thenπ dec(len); { Get rid of trailing space }π if not ((len = max) or (len = 0)) then beginπ x := pos('.',jstr); { Attempt to start padding at sentence break }π if (x = 0) or (x =len) then { no period or period is at length }π x := 1; { so start at beginning }π if pos(space,jstr) <> 0 then Repeat { ensure at least 1 space }π if jstr[x] = space then { so add a soft space }π insert(softSpace,jstr,x+1);π x := succ(x mod len); { if eoln is reached return and do it again }π Until len = max; { Until the wanted String length is achieved }π end; { if not ... }π JustifiedStr := jstr;π end; { JustifiedStr }πππ begin { Wrap }π if len <= maxlen then begin { no wrapping required }π Wrap := st;π len := 0;π end else beginπ oldlen := len; { save the length of the original String }π len := succ(maxlen); { set length to maximum }π Repeat { find last space in st beFore or at maxlen }π dec(len);π Until (st[len] = space) or (len = 0);π if len = 0 then { no spaces in st, so chop at maxlen }π len := maxlen;π if justify thenπ Wrap := JustifiedStr(st,maxlen)π elseπ Wrap := st;π newlen := len; { save the length of the newly wrapped String }π len := oldlen; { and restore it to original length beFore }π Delete(st,1,newlen); { getting rid of the wrapped portion }π end;π end; { Wrap }ππbeginπ S :=π'By Far the easiest way to manage a database is to create an '+π'index File. An index File can take many Forms and its size will depend '+π'upon how many Records you want in the db. The routines that follow '+π'assume no more than 32760 Records.';ππWhile length(S) <> 0 doπ Writeln(Wrap(S,60,True));πend.ππWhilst this is tested and known to work on the example String, no furtherπtesting than that has been done. I suggest you test it a great deal moreπbeFore being satisfied that it is OK.ππ
